home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FishMarket 1.0
/
FishMarket v1.0.iso
/
fishies
/
376-400
/
disk_386
/
xlispstat
/
src1.lzh
/
XLisp
/
xlisp.c
< prev
next >
Wrap
C/C++ Source or Header
|
1990-10-04
|
4KB
|
183 lines
/* xlisp.c - a small implementation of lisp with object-oriented programming */
/* Copyright (c) 1989, by David Michael Betz. */
/* You may give out copies of this software; for conditions see the file */
/* COPYING included with this distribution. */
#include <stdlib.h>
#include "xlisp.h"
#include "osdef.h"
#ifdef ANSI
#include "xlproto.h"
#include "osproto.h"
void main(int,unsigned char *[]);
#else
#include "xlfun.h"
#include "osfun.h"
#endif ANSI
#ifdef AMIGA
#include "autil1.h"
extern char deftool[];
#endif AMIGA
#include "xlvar.h"
/* define the banner line string */
#define BANNER "XLISP version 2.1, Copyright (c) 1989, by David Betz"
/* global variables */
jmp_buf top_level;
char *progname; /* used for reading the symbol table - L. Tierney */
/* main - the main routine */
void main(argc,argv)
int argc; unsigned char *argv[];
{
char *transcript;
CONTEXT cntxt;
int verbose,i;
LVAL expr;
#ifdef AMIGA
char project[30],defdir[50];
#endif AMIGA
/* setup default argument values */
transcript = NULL;
verbose = FALSE;
/* parse the argument list switches */
#ifndef MACINTOSH
#ifdef AMIGA
FindStart(&argc,argv,deftool,project,defdir);
#endif AMIGA
progname = argv[0]; /* L. Tierney */
for (i = 1; i < argc; ++i)
if (argv[i][0] == '-')
switch(argv[i][1]) {
case 't':
case 'T':
transcript = &argv[i][2];
break;
case 'v':
case 'V':
verbose = TRUE;
break;
}
#endif /* MACINTOSH */
/* initialize and print the banner line */
osinit(BANNER);
/* setup initialization error handler */
xlbegin(&cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,(LVAL)1);
if (setjmp(cntxt.c_jmpbuf))
xlfatal("fatal initialization error");
if (setjmp(top_level))
xlfatal("RESTORE not allowed during initialization");
/* initialize xlisp */
xlinit();
xlend(&cntxt);
/* reset the error handler */
xlbegin(&cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,true);
/* open the transcript file */
if (transcript && (tfp = osaopen(transcript,"w")) == NULL) {
sprintf(buf,"error: can't open transcript file: %s",transcript);
stdputstr(buf);
}
/* load "init.lsp" */
if (setjmp(cntxt.c_jmpbuf) == 0)
xlload("init.lsp",TRUE,FALSE);
/* load any files mentioned on the command line */
if (setjmp(cntxt.c_jmpbuf) == 0)
for (i = 1; i < argc; i++)
if (argv[i][0] != '-' && !xlload(argv[i],TRUE,verbose))
xlerror("can't load file",cvstring(argv[i]));
/* target for restore */
if (setjmp(top_level))
xlbegin(&cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,true);
/* protect some pointers */
xlsave1(expr);
/* main command processing loop */
for (;;) {
/* setup the error return */
if (setjmp(cntxt.c_jmpbuf)) {
setvalue(s_evalhook,NIL);
setvalue(s_applyhook,NIL);
xltrcindent = 0;
xldebug = 0;
osreset(); /* L. Tierney */
xlflush();
}
/* print a prompt */
stdputstr("> ");
/* read an expression */
if (!xlread(getvalue(s_stdin),&expr,FALSE))
break;
/* process carriage return (to clean up dribble) - L. Tierney */
if (xlpeek(getvalue(s_stdin)) == '\n')
xlgetc(getvalue(s_stdin));
/* save the input expression */
xlrdsave(expr);
/* evaluate the expression */
expr = xleval(expr);
/* save the result */
xlevsave(expr);
/* print it */
stdprint(expr);
}
xlend(&cntxt);
/* clean up */
wrapup();
}
/* xlrdsave - save the last expression returned by the reader */
void xlrdsave(expr)
LVAL expr;
{
setvalue(s_3plus,getvalue(s_2plus));
setvalue(s_2plus,getvalue(s_1plus));
setvalue(s_1plus,getvalue(s_minus));
setvalue(s_minus,expr);
}
/* xlevsave - save the last expression returned by the evaluator */
void xlevsave(expr)
LVAL expr;
{
setvalue(s_3star,getvalue(s_2star));
setvalue(s_2star,getvalue(s_1star));
setvalue(s_1star,expr);
}
/* xlfatal - print a fatal error message and exit */
void xlfatal(msg)
char *msg;
{
oserror(msg);
wrapup();
}
/* wrapup - clean up and exit to the operating system */
void wrapup()
{
if (tfp)
osclose(tfp);
osfinish();
exit(0);
}